home *** CD-ROM | disk | FTP | other *** search
/ PCGUIA 127 / PC Guia 127.iso / Software / Produtividade / OpenOffice.org 2.0.1 / openofficeorg1.cab / Samples.xba < prev    next >
Extensible Markup Language  |  2005-04-06  |  6KB  |  185 lines
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Samples" script:language="StarBasic">Option Explicit
  4.  
  5. Const SAMPLES = 1000
  6. Const STYLES = 1100
  7. Const aTempFileName = "Berend_Ilko_Tom_Stella_Volker.stc"
  8. Public Const Twip = 425
  9. Dim oUcbObject as Object
  10. Public StylesDir as String
  11. Public StylesDialog as Object
  12. Public PathSeparator as String
  13. Public oFamilies  as Object
  14. Public aOptions(0) as New com.sun.star.beans.PropertyValue
  15. Public sQueryPath as String
  16. Public NoArgs()as New com.sun.star.beans.PropertyValue
  17. Public aTempURL as String
  18.  
  19. Public Files(100) as String
  20.  
  21.  
  22. '--------------------------------------------------------------------------------------
  23. 'Miscellaneous Section starts here
  24.  
  25. Function PrepareForEditing(Optional ByVal oDocument)
  26. 'This sub is called when sample documents are loaded (load event).
  27. 'It checks whether the documents is read-only, in which case it
  28. 'offers the user to create a new (writable) document using the original
  29. 'as a template.
  30. Dim DocPath as String
  31. Dim MMessage as String
  32. Dim MTitle as String
  33. Dim RValue as Integer
  34. Dim oNewDocument as Object
  35. Dim mFileProperties(1) as New com.sun.star.beans.PropertyValue
  36.     PrepareForEditing = NULL
  37.         BasicLibraries.LoadLibrary( "Tools" )
  38.     If InitResources("'Template'", "tpl") then
  39.         If IsMissing(oDocument) Then
  40.               oDocument = ThisComponent
  41.         End If
  42.         If oDocument.IsReadOnly then
  43.             MMessage = GetResText(SAMPLES)
  44.             MTitle = GetResText(SAMPLES + 1)
  45.             RValue = Msgbox(MMessage, (128+48+1), MTitle)
  46.             If RValue = 1 Then
  47.                 DocPath = oDocument.URL
  48.                 mFileProperties(0).Name = "AsTemplate"
  49.                 mFileProperties(0).Value = True
  50.                 mFileProperties(1).Name = "MacroExecutionMode"
  51.                 mFileProperties(1).Value = com.sun.star.document.MacroExecMode.USE_CONFIG    
  52.                 
  53.                 oNewDocument = StarDesktop.LoadComponentFromURL(DocPath,"_default",0, mFileProperties())
  54.                 PrepareForEditing() = oNewDocument
  55.                 DisposeDocument(oDocument)
  56.             Else
  57.                 PrepareForEditing() = NULL
  58.             End If
  59.         Else
  60.             PrepareForEditing() = oDocument
  61.         End If
  62.     End If
  63. End Function
  64.  
  65.  
  66.  
  67. '--------------------------------------------------------------------------------------
  68. 'Calc Style Section starts here
  69.  
  70. Sub ShowStyles
  71. 'This sub displays the style selection dialog if the current document is a calc document.
  72. Dim TemplateDir, ActFileTitle, DisplayDummy as String
  73. Dim sFilterName(0) as String
  74. Dim StyleNames() as String
  75. Dim t as Integer
  76. Dim MaxIndex as Integer
  77.         BasicLibraries.LoadLibrary("Tools")
  78.     If InitResources("'Template'", "tpl") then
  79.     oDocument = ThisComponent
  80.         If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
  81.             ToggleWindow(False)
  82.             oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  83.             oFamilies = oDocument.StyleFamilies
  84.             SaveCurrentStyles(oDocument)
  85.             StylesDialog = LoadDialog("Template", "DialogStyles")
  86.             DialogModel = StylesDialog.Model
  87.             TemplateDir = GetPathSettings("Template", False, 0)
  88.             StylesDir = GetOfficeSubPath("Template", "wizard/styles/")
  89.             sQueryPath = GetOfficeSubPath("Template", "wizard/bitmap/")
  90.             DialogModel.Title = GetResText(STYLES)
  91.             DialogModel.cmdCancel.Label = GetResText(STYLES+2)
  92.             DialogModel.cmdOk.Label = GetResText(STYLES+3)
  93.             Stylenames() = ReadDirectories(StylesDir, False, False, True,)
  94.             MaxIndex = Ubound(Stylenames())
  95.             BubbleSortList(Stylenames(),True)
  96.             Dim cStyles(MaxIndex)
  97.             For t = 0 to MaxIndex
  98.                 Files(t) = StyleNames(t,0)
  99.                 cStyles(t) = StyleNames(t,1)
  100.             Next t
  101.             On Local Error Resume Next
  102.             DialogModel.lbStyles.StringItemList() = cStyles()
  103.             ToggleWindow(True)
  104.             StylesDialog.Execute
  105.         End If
  106.     End If
  107. End Sub
  108.  
  109.  
  110. Sub SelectStyle
  111. 'This sub loads the specific styles from a style document and loads them into the
  112. 'current document.
  113. Dim StylePath as String
  114. Dim NewStyle as String
  115. Dim Position as Integer
  116.     Position = DialogModel.lbStyles.SelectedItems(0)
  117.     If Position > -1 Then
  118.         ToggleWindow(False)
  119.         StylePath = Files(Position)
  120.           aOptions(0).Name = "OverwriteStyles"
  121.          aOptions(0).Value = true
  122.         oFamilies.loadStylesFromURL(StylePath, aOptions())
  123.         ToggleWindow(True)
  124.     End If
  125. End Sub
  126.  
  127.  
  128. Sub SaveCurrentStyles(oDocument as Object)
  129. 'This sub stores the current document in the user work directory
  130.     On Error Goto ErrorOcurred
  131.     aTempURL = GetPathSettings("Work", False)
  132.     Dim aRightMost as String
  133.     aRightMost = Right(aTempURL, 1)
  134.     if aRightMost = "/" Then
  135.         aTempURL = aTempURL & aTempFileName
  136.     Else
  137.         aTempURL = aTempURL & "/" & aTempFileName
  138.     End If
  139.  
  140.     While FileExists(aTempURL)
  141.         aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.stc"
  142.     Wend
  143.     oDocument.storeToURL(aTempURL, NoArgs())
  144.     Exit Sub
  145.  
  146. ErrorOcurred:
  147.     MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES ))
  148.     On Local Error Goto 0
  149. End Sub
  150.  
  151.  
  152. Sub RestoreCurrentStyles
  153. 'This sub retrieves the styles from the temporarily save document
  154.     ToggleWindow(False)
  155.     On Local Error Goto NoFile
  156.     If FileExists(aTempURL) Then
  157.           aOptions(0).Name = "OverwriteStyles"
  158.           aOptions(0).Value = true
  159.         oFamilies.LoadStylesFromURL(aTempURL, aOptions())
  160.         KillTempFile()
  161.     End If
  162.     StylesDialog.EndExecute
  163.     ToggleWindow(True)
  164. NOFILE:
  165.     If Err <> 0 Then
  166.         Msgbox("Cannot load Document from " & aTempUrl, 64, GetProductname())
  167.     End If
  168.     On Local Error Goto 0
  169. End Sub
  170.  
  171.  
  172. Sub CloseStyleDialog
  173.     KillTempFile()
  174.     DialogExited = True
  175.     StylesDialog.Endexecute
  176. End Sub
  177.  
  178.  
  179. Sub KillTempFile()
  180.     If oUcbObject.Exists(aTempUrl) Then
  181.         oUcbObject.Kill(aTempUrl)
  182.     End If
  183. End Sub
  184.  
  185. </script:module>